home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 11 / Cream of the Crop 11-1.iso / comm / tcp4w15.zip / PWTN.PAS < prev    next >
Pascal/Delphi Source File  |  1995-09-11  |  4KB  |  149 lines
  1. Program PWTNDEMO;
  2. {$A+,B-,D+,F-,G+,I-,K+,L+,N-,P+,Q+,R+,S+,T+,V+,W+,X+,Y+}
  3. {$M 8192,8192}
  4. {Simple Telnet Client for PWTN}
  5.  
  6. Uses WinTypes, WinProcs, WinCrt, Strings, UseTcp4W;
  7.  
  8. Const LTIL = 9900; {Long Text Item Length}
  9.  
  10. Type PLTI = ^TLTI;   {Long Text Item}
  11.      TLTI = Array [0..LTIL] Of Char;
  12.  
  13. Var Status, Port: Integer;
  14.     S: TSocket;
  15.     T: TLTI;
  16.     SaveExitProc : Pointer;
  17.  
  18. Procedure CheckStatus;
  19.   Begin
  20.     If Status > 0 Then Exit;
  21.     WriteLn ('?', TCP4W_Error (Status));
  22.     Halt
  23.   End;
  24.  
  25. Procedure HandleTelnetControl (S: TSocket; P: PLTI; Len: Integer);
  26.   {See RFC 854, 855, 930 at www.internic.net}
  27.   Begin
  28.     WriteLn;
  29.     If (P^[1] = #253) And (P^[2] = #24) Then
  30.       Begin
  31.         P^[1] := #251;
  32.         TcpSend (S, P^, 3, False, -1);
  33.         Exit
  34.       End;
  35.     If (P^[1] = #250) And (P^[2] = #24) Then
  36.       Begin
  37.         StrPCopy (P^, #255#250#24#0'UNKNOWN'#255#240);
  38.         TcpSend (S, P^, 13, False, -1);
  39.         Exit
  40.       End;
  41.     If (P^[1] = #251) Then
  42.       Begin
  43.         If P^[2] = #1 Then P^[1] := #253 Else P^ [1] := #254;
  44.         TcpSend (S, P^, 3, False, -1);
  45.         Exit
  46.       End;
  47.     If (P^[1] = #252) Then
  48.       Begin
  49.         P^ [1] := #254;
  50.         TcpSend (S, P^, 3, False, -1);
  51.         Exit
  52.       End;
  53.   End;
  54.  
  55. Function TelnetRecv (S: TSocket; P: PLTI; MaxLen: Integer): Integer;
  56.   Var Len, Start, I: Integer;
  57.       H: String;
  58.   Begin
  59.     Len := TCPRecv (S, P^, MaxLen, 10, -1);
  60.     TelnetRecv := Len;
  61.     If Len <= 0 Then
  62.       Begin
  63.         P^[0] := #0;
  64.         Exit
  65.       End;
  66.     H := '';
  67.     Start := -1;
  68.     I := 0;
  69.     While I < Len Do
  70.       Begin
  71.         If (P^[I] = #255) And (Start = -1) Then
  72.           Start := I;
  73.         If Start >= 0 Then H := H + P^[I];
  74.         If ((Start >= 0) And (P^[I] = #240)) Or
  75.            ((Start >= 0) And (Start = I-2) And (H [2] <> #250)) Then
  76.           Begin
  77.             HandleTelnetControl (S, PLTI (@H [1]), Length (H));
  78.             Move (P^[I+1], P^[Start], Len-I-1);
  79.             Len := Len - (I-Start+1);
  80.             I := Start-1;
  81.             H := '';
  82.             Start := -1;
  83.           End;
  84.         If I >= 0 Then
  85.           If P^[I] = #0 Then P^[I] := #4;
  86.        Inc (I);
  87.       End;
  88.     P^[Len] := #0
  89.   End;
  90.  
  91. Procedure MainLoop;
  92.   Var I, J: Integer;
  93.   Begin
  94.     Write (#129);
  95.     Repeat
  96.       If KeyPressed Then
  97.         Begin
  98.           T [0] := ReadKey;
  99.           If T [0] = #3 Then Exit;
  100.           T [1] := #0;
  101.           Status := TcpSend (S, T, 1, False, -1);
  102.           CheckStatus;
  103.         End;
  104.       If TCPIsDataAvail (S) > 0 Then
  105.         Begin
  106.           Write (#8#32#8);
  107.           Status := TelnetRecv (S, @T, LTIL);
  108.           CheckStatus;
  109.           J := StrLen (T);
  110.           For I := 0 To J-1 Do
  111.             If (T [I] = #13) And (T [I+1] = #4) Then
  112.               T [I] := #4;
  113.           Write (T, #129);
  114.         End;
  115.     Until False;
  116.   End;
  117.  
  118. Procedure MyExitProc; Far;
  119.   Begin
  120.     ExitProc := SaveExitProc;
  121.     If S <> 0 Then TcpClose (S);
  122.   End;
  123.  
  124. Begin
  125.   CheckBreak := False;
  126.   CmdShow := sw_ShowMaximized;
  127.   AutoTracking := False;
  128.   TCP4WInit;
  129.   WriteLn ('Simple Telnet Client by AStA (Andreas.Tikart@uni-konstanz.de) <Polarwolf>');
  130.   TCP4WVer (T, LTIL);
  131.   WriteLn (T);
  132.   WriteLn;
  133.   S := 0;
  134.   SaveExitProc := ExitProc;
  135.   ExitProc := @MyExitProc;
  136.  
  137.   Write ('Host:');
  138.   ReadLn (T);
  139.   Port := 23;
  140.   Status := TcpConnect (S, T, '', Port);
  141.   CheckStatus;
  142.   MainLoop;
  143.   Status := TcpClose (S);
  144.   S := 0;
  145.   CheckStatus;
  146.   ExitProc := SaveExitProc;
  147.   DoneWinCrt;
  148. End.
  149.